﻿<%
'
' 数据库操作，外部可以直接引用
' 要求：共同属性写入底层，这部分只是用于展现
' 函数命名：兼容旧系统,暂时没有统一

'取用户稿子数
Function getUserEssay(id)
	getUserEssay=hu.conn("select count(id) from 74hu_article where hu_author='"&id&"'")(0)
End Function

'显示公告
Function getReport
	Dim rss
	Set rss=hu.conn( "select top 1 id,name from 74hu_gonggao order by id desc")
	If Not rss.eof Then
		getReport = hu.url("report.asp?id="&rss("id")&"&amp;action=view",nowml(getLeft(rss("name"),10)))&"<br/>"
	End If
	rss.close
	Set rss=Nothing
End Function

'关闭数据库连接
Sub getClose()
	conn.close
	set conn=nothing
End Sub

'IP封锁
Sub ipLock(str)
	Dim IpArray,WhyIpLock,IpSQL,IpRS
	IpArray=split(str,".")
	IpSQL="select top 1 iplock from 74hu_IpLock where "& _
	" (ipsame=4 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" and ip3="&Cint(IpArray(2))&" and ip4="&Cint(IpArray(3))&" )  "& _
	" Or (ipsame=3 and  ip1="&Cint(IpArray(0))&"  and  ip2="&Cint(IpArray(1))&"  and  ip3="&Cint(IpArray(2))&" )   "& _
	" Or (ipsame=2 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" ) Or (ipsame=1 and ip1="&Cint(IpArray(0))&" ) order by ipid "
	Set IpRS=hu.conn(IpSQL)
	If Not (IpRS.bof or IpRS.eof) Then
		WhyIpLock=split(IpRS("iplock"),"|")
		Response.write "你使用的IP段或IP地址已被封锁<br/>封锁原因:"&WhyIpLock(1)&"<br/>封锁时间:"&WhyIpLock(0)&""
		Response.End
		' Set Conn=nothing
	End If
	Set IpRS=Nothing
End Sub

'事务经理 负责创建会话,日常维护
'	创建会话
'	流量统计
'	ip封锁
'	删除记录
Sub affairsManager
	setSessionBySid()'分析会话,这个函数必须放在 huClass 实例前,原因是生成 sid
	Set hu = New huClass
	With hu
		.Debug = False'开发模式
		.LogPath = "/logs"
		.CurPath = http_path
		.Db = db
		.SidKey = bbsSid
		.Sid = sid
		If hu_style=True Then
			.Style = 2
			.Css = cssStyle
		End If
		.align = wapConst
	End With
	checkUpdate()'系统维护检测
	'数据库连接
	'会话 -- 建立
	user_array(0)="0"		'ID
	user_array(1)="游客"	'名称
	user_array(2)="-1"		'等级
	user_array(3)=""		'生日
	user_array(4)="0"		'状态
	user_array(5)=""		'注册时间
	user_array(6)="0"		'性别
	user_array(7)= user_ip_agent & Left(user_ip_port, InstrRev(user_ip_port,"."))'移动手机IP变动较大,尽可能合理控制
	' user_array(7)= user_ip_agent & Left(user_ip_port, InstrRev(user_ip_port,".")-1)
	'移动手机IP变动较大,尽可能合理控制	（这里user_ip_port如果没有点号，Left函数可能会溢出，所以不要减1）

	If sid_val<>"" Then newUser(sid_val)'构造会话
	'sid_str=bbsSid&"="&sid'生成会话
	'会话 -- 完成
	ipLock(User_ip)'ip封锁
	Dim rsip,user_ip_,userid_,ip_one_day_counter_,ip_one_day_top_,ip_total_,rsiprr,if_on_daty_now_
	userid_=user_array(0)
	Set rsip = hu.conn("select top 1 HU_Date,HU_Tod,HU_Today,HU_counter from 74hu_counter where id=1")
	If Not rsip.eof Then
		ip_one_day_counter_=rsip("HU_Today")'今日IP访问量
		ip_one_day_top_=rsip("HU_Tod")'单日最高IP访问量
		ip_total_=rsip("HU_counter")'总IP访问量

		'现在是否需要值日（完成日常维护工作，日行一次）
		if_on_daty_now_ = False
		if time_date<>rsip("HU_Date") then if_on_daty_now_ = True

		if if_on_daty_now_=True then'日常维护工作
			If ifNum(linkDelete) Then
				If linkDelete>0 Then hu.conn("delete from 74hu_link where (hu_time<#"&dateadd("d", linkDelete*-1, time_now)&"#)")'删除N天前的无连入友链
			End If
			hu.conn("delete from 74hu_message where (savetime<#"&dateadd("d", bbsMsgKeep*-1, time_now)&"#)")'删除N天前的消息记录
			hu.conn("update 74hu_counter set HU_Browser=0,HU_Date='"&time_date&"',HU_Yays=HU_Yays+1,HU_Yesterday="&ip_one_day_counter_&" where id=1")'流量统计
			ip_one_day_counter_=0
			hu.conn("delete from 74hu_iprr")
		end if

		'统计访问
		user_ip_ = user_array(7)
		Set rsiprr=hu.conn("select id from 74hu_iprr where hu_userip='"&user_ip_&"'")
		If rsiprr.eof Then
			hu.conn("insert into 74hu_iprr (hu_userip,userid,[time]) values ('"&user_ip_&"',"&userid_&",'"&time_now&"')")
			ip_total_=ip_total_+1
			ip_one_day_counter_=ip_one_day_counter_+1
		End If
		rsiprr.close
		Set rsiprr=Nothing
		If ip_one_day_counter_>ip_one_day_top_ Then
			ip_one_day_top_=ip_one_day_counter_
		End If
		hu.conn("update 74hu_counter set HU_Browsers=HU_Browsers+1,HU_Browser=HU_Browser+1,HU_Tod="&ip_one_day_top_&",HU_counter="&ip_total_&",HU_Today="&ip_one_day_counter_&" where id=1")
	End If
	rsip.close
	set rsip=nothing
	If hu_access=False And wapAccess<>"" And userid_=0 Then
		If wapAccess="999" Then
			url_=back_url
			rupt "精彩内容,会员独享","网站精彩内容,会员独享！<br/><a href="""&http_path&"bbs_login.asp?_u="&url_&""">现在登录</a> "&_
				"<a href="""&http_path&"bbs_reg.asp?_u="&url_&""">还没注册？</a>"
		End If
	End If
	main() '执行 Main 函数
	hu.body = "<br/>"& ubbCode(wapLast)&"<!-- 74hujz "&sysver&" exec "&FormatNumber((timer-time_start), 3, true)&"s db_query "&hu.ConnCount&" times -->"
	'Set hu = Nothing '这里设置之后不捕捉sql注入
End Sub

'生成唯一的sid值，使用时要引用md5以及建立连接
Function getOnlySid()
	Dim tmp_,count_
	tmp_=md5(md5(hu_randomize,16),32)
	count_=hu.conn("select count(id) from 74hu_user where sid='"&tmp_&"'")(0)
	if count_<>0 then tmp_=getOnlySid()
	getOnlySid=tmp_
End Function

''随机广告,定义数目
Function getAD(typeID, num)
	If typeID<>1 And typeID<>2 And typeID<>3 And typeID<>4 And typeID<>5 Then getAD="":Exit Function
	Dim rsads,newad
	Set rsads=hu.conn("select top "&num&" g.id,g.name from 74hu_gogo g,74hu_control c where c.ads"&typeID&"=1 and g.typeID="&typeID&" order by rnd(-(g.id+" & rnd() & ")) ")
	While Not rsads.EOF
		newad = newad& hu.url("url.asp?id="&rsads("id"),noubb(rsads("name")))&"<br/>"
		rsads.MoveNext
	Wend
	rsads.close
	Set rsads=Nothing
	getAD=newad
End Function

'定义广告
Function adsetkf(adnum)
	Dim rsadset
	Set rsadset=hu.conn("select "&adnum&" from 74hu_control where ID=1")
	If Not rsadset.eof Then
		adsetkf=rsadset(adnum)
	End If
	rsadset.close
	Set rsadset=nothing
End Function

'生成文章链接
Function getArticle(relid,num,typeid)
	Dim str,rs,sql,sqlOrder
	str=""
	sqlOrder=""
	If relid<>"" Then str="and classid in("&relid&")"
	Select Case typeid
	Case 1:'最新文章
		sqlOrder="order by id desc"
	Case 2:'最热文章
		sqlOrder="order by hit*100000+id desc"
	Case 3:'随机文章
		sqlOrder="order by rnd(-(id*"&rnd()&"))"
	Case 4:'推荐文章
		str=str&" and recommend=1"
		sqlOrder="order by rnd(-(id*"&rnd()&"))"
	End Select
	sql="select top "&num&" id,title from 74hu_article where classid<>0 "&str&" "&sqlOrder
	str=""
	Set rs=hu.conn(sql)
	If Not rs.eof Then
		If hu_getLeft Then
			While Not rs.eof
				str=str& hu.url("article.asp?id="&rs("id"),getLeft(noubb(rs("title")),numTitle))&"<br/>"
				rs.MoveNext
			Wend
		Else
			While Not rs.eof
				str=str& hu.url("article.asp?id="&rs("id"),noubb(rs("title")))&"<br/>"
				rs.MoveNext
			Wend
		End If
	Else
		str="还没有文章！<br/>"
	End If
	rs.close
	Set rs=Nothing
	getArticle=str
End Function

'生成帖子链接
Function getPost(relid,num,typeid)
	Dim str,rs,sql,sqlOrder
	str=""
	sqlOrder=""
	If relid<>"" Then str="and classid in("&relid&")"
	Select Case typeid
	Case 1:'最新帖子
		sqlOrder="order by id desc"
	Case 2:'最热帖子
		sqlOrder="order by hit*100000+id desc"
	Case 3:'随机帖子
		sqlOrder="order by rnd(-(id*"&rnd()&"))"
	Case 4:'精华贴
		str=str&" and type=1 or type=12 or type=13"
		sqlOrder="order by rnd(-(id*"&rnd()&"))"
	End Select
	sql="select top "&num&" id,title from 74hu_topic where 1 "&str&" "&sqlOrder
	str=""
	Set rs=hu.conn(sql)
	If Not rs.eof Then
		If hu_getLeft Then
			While Not rs.eof
				str=str& hu.url("bbs_posts.asp?id="&rs("id"),getLeft(noubb(rs("title")),numTitle))&"<br/>"
				rs.MoveNext
			Wend
		Else
			While Not rs.eof
				str=str& hu.url("bbs_posts.asp?id="&rs("id"),noubb(rs("title")))&"<br/>"
				rs.MoveNext
			Wend
		End If
	Else
		str="还没有帖子！<br/>"
	End If
	rs.close
	Set rs=Nothing
	getPost=str
End Function

'最新文章
Function newtitle(num,relid)
	newtitle = getArticle(relid,num,1)
End Function

'最热文章
Function hottitle(num,relid)
	hottitle = getArticle(relid,num,2)
End Function

'随机文章
Function wendtitle(num,relid)
	wendtitle = getArticle(relid,num,3)
End Function

'推荐帖子
Function recommendtitle(num,relid)
	recommendtitle = getArticle(relid,num,4)
End Function

'最新帖子
Function newpost(num,relid)
	newpost = getPost(relid,num,1)
End Function

'最热帖子
Function hotpost(num,relid)
	hotpost = getPost(relid,num,2)
End Function

'随机帖子
Function wendpost(num,relid)
	wendpost = getPost(relid,num,3)
End Function

'精华帖子
Function recommendpost(num,relid)
	recommendpost = getPost(relid,num,4)
End Function

'动态友链
Function topLink(max,num)
	Dim Rslc,aaa,body_
	body_ = ""
	If Trim(max)="" or IsNumeric(max)=False Then max=8
	If Trim(num)="" or IsNumeric(num)=False Then num=4
	Sqlink = "select top "&max&" id,namt from 74hu_link Where active=0 and del=0 order by HU_time desc,id desc"
	Set Rslc = hu.conn(Sqlink)
	If Rslc.EOF Then body_ = body_ & "暂无友链！<br/>"
	aaa = 1
	Do While ((Not Rslc.EOF) And aaa <= max)
		body_ = body_ & hu.url("link.asp?id=" & Rslc("id") & "&amp;act=view", noubb(Rslc("namt")) )& " "
		If aaa Mod num = 0 And aaa <> Rslc.RecordCount Then body_ = body_ & "<br/>"
		Rslc.MoveNext
		aaa = aaa + 1
	Loop
	Rslc.Close
	Set Rslc = Nothing
	topLink = body_
End Function

'构造会话,会员实例
Sub newUser(sid)
	Dim rs_,sql_,url_
	If IsNull(sid) Or sid="" Then sid="74hujz_null"
	Set rs_ = hu.conn("select top 1 id,name,logip,hu_level,birthday,status,regtime,sex from 74hu_user where sid='"&sid&"'")
	If Not rs_.eof Then
		If bbsIp=0 Or user_ip=rs_("logip") Then'IP异常要重新登录
			user_array(0)=rs_("id")
			user_array(1)=rs_("name")
			user_array(2)=rs_("hu_level")
			user_array(3)=rs_("birthday")
			user_array(4)=rs_("status")
			user_array(5)=rs_("regtime")
			user_array(6)=rs_("sex")
			'更新在线时间
			hu.conn("update 74hu_user set logip='"&user_ip&"',logtime='"&time_now&"' where id="&user_array(0)&"")
		Else
			url_=back_url
			rupt "页面出错","检测IP异常,请重新登录！<br/><a href="""&http_path&"bbs_login.asp?_u="&url_&""">现在登录</a> "&_
				"<a href="""&http_path&"bbs_reg.asp?_u="&url_&""">还没注册？</a>"
		End If
	End If
	rs_.close
	Set rs_=Nothing
End Sub

'验证好友关系
'-1 : 不是好友,以对方信息为准
'0  : 等待对方审核,还不是好友
'1  : 好友
'2  : 黑名单
Function getFriendship(id)
	Dim usr
	usr=user_array(0)'取当前会员ID
	If id=0 Or usr=0 Or id=usr Then getFriendship=-1:Exit Function
	Dim rs_,sql_
	' Set rs_=Server.CreateObject("ADODB.Recordset")
	sql_ = "select state from 74hu_friend where fid="&usr&" and uid="&id&""'以对方为准
	Set rs_= hu.conn(sql_)
	If Not rs_.eof Then
		getFriendship = rs_("state")
	Else
		getFriendship = -1
	End If
	rs_.close
	Set rs_=Nothing
End Function

'获取用户名
Function getUserName(id)
	Dim rs_
	Set rs_= hu.conn("select top 1 name from 74hu_user where id="&id)
	If Not rs_.eof Then
		getUserName=rs_("name")
	Else
		getUserName=""
	End If
	rs_.close
	Set rs_=Nothing
End Function

'获取用户的状态，用于屏蔽操作
Function getUserStatus(id)
	Dim rs_
	Set rs_= hu.conn("select top 1 status from 74hu_user where id="&id)
	If Not rs_.eof Then
		getUserStatus=rs_("status")
	Else
		getUserStatus=-1
	End If
	rs_.close
	Set rs_=Nothing
End Function

'在线会员
Function getOnline(str)
	If str="1" or str="2" Then
		str="and sex="&str
	Else
		str=""
	End If
	getOnline=hu.conn("select count(id) from 74hu_user where (logtime>#"&dateadd("n", -20, time_now)&"#) "&str)(0)
End Function

'系统发送信息给用户
Sub sendMsgToUserBySystem(userid, msg)
	hu.conn("insert into 74hu_message (userid,receive,savetime,content,state,flag)values(0,"&userid&",'"&time_now&"','"&msg&"',0,0)")
End Sub

'检测有没有未读信息
Function getUserMsgCount(id)
	Dim count_
	getUserMsgCount=hu.conn("select count(id) from 74hu_message where state=0 and flag<>"&id&" and receive="&id)(0)
End Function

'好友申请列表数
Function getUserFriendApplyCount(id)
	Dim count_
	getUserFriendApplyCount=hu.conn("select count(id) from 74hu_friend where state=0 and uid="&id)(0)
End Function

'实现设计中心页面
Function classPage(id)
	Dim rs_,body_,wmltxt
	Set rs_ = hu.conn("select lx,class,wmltxt,relid,br,num,classid from 74hu_class where parent="&id&" and hide=0 order by pid asc,classid desc")
	If rs_.eOF Then
		body_ = "网站建设中..<br/>"
	else
		body_ = ""
		Do While Not rs_.eOF
			Select Case rs_("lx")
				Case 2 body_ = body_ & ubbcode(forQuote(rs_("wmltxt")))
				Case 9 body_ = body_ & wmlcode(rs_("wmltxt"))
				Case 8 body_ = body_ & getAD(1,1)
				Case 10 body_ = body_ & newtitle(rs_("num"), rs_("wmltxt"))
				Case 11 body_ = body_ & hottitle(rs_("num"), rs_("wmltxt"))
				Case 12 body_ = body_ & wendtitle(rs_("num"), rs_("wmltxt"))
				Case 13 body_ = body_ & newpost(rs_("num"), rs_("wmltxt"))
				Case 14 body_ = body_ & hotpost(rs_("num"), rs_("wmltxt"))
				Case 15 body_ = body_ & wendpost(rs_("num"), rs_("wmltxt"))
				Case 16 body_ = body_ & recommendtitle(rs_("num"), rs_("wmltxt"))
				Case 17 body_ = body_ & recommendpost(rs_("num"), rs_("wmltxt"))
				Case 0 body_ = body_ & hu.url("class.asp?id="&rs_("classid"), nowml(rs_("class")))
				Case 1 body_ = body_ & hu.url("list.asp?id="&rs_("relid"), nowml(rs_("class")))
				Case 3 body_ = body_ & hu.url("bbs_topic.asp?id="&rs_("relid"), nowml(rs_("class")))
				Case 19 body_ = body_ & getSearchXml
				Case 20 body_ = body_ & getWorldComment(rs_("num"))
			End Select
			If rs_("br") = "1" Then body_ = body_ & "<br/>"
			rs_.MoveNext
		Loop
	end If
	rs_.close
	Set rs_ = nothing
	classPage = body_
End Function

'检查文章是否重复,seo需要
Function ifArticleRepeat(title)
	ifArticleRepeat=False
	If 0<>hu.conn("select count(id) from 74hu_article where title='"&title&"'")(0) Then ifArticleRepeat=True
End Function

'群聊功能
Function getWorldComment(num)
	dim rs,str,count,tid
	If num<=0 Then num=3
	count=hu.conn("select count(id) from 74hu_pl where smsid=0")(0)
	tid=count
	Set rs=hu.conn("select top "&num&" pl from 74hu_pl where smsid=0 order by id desc")
	if Not rs.eof Then
		while Not rs.eof
			str=str&""&tid&"楼."&getLeft(noubb(noad(rs("pl"))),10)&"<br/>"
			rs.movenext
			tid=tid-1
		Wend
		str=str& hu.url("discuss.asp?id=0", "网友群聊("&count&")")
	Else
		str= hu.url("discuss.asp?id=0", "快来群聊吧")
	end if
	If wapDiscuss = "1" And user_array(0)=0 Then
		getWorldComment=str&" "&hu.url("bbs_login.asp?u="&back_url,"登录群聊")
	Else
		getWorldComment=str&"<br/>"&getWorldCommentXml
	End If
End Function

'会员增减金币,积分,经验,用于非用户消费情况
Sub setUserAmount(userid, rules)
	Dim ruleArray,money,point,expr
	ruleArray = Split(rules&"",",")
	If UBound(ruleArray)<2 Then rupt "错误","积分规则配置出错"
	money = ruleArray(0)
	point = ruleArray(1)
	expr = ruleArray(2)
	If hu_isNumber(money) And hu_isNumber(point) And hu_isNumber(expr) And userid>0 Then
		If money>=0 Then money="+"&money
		If point>=0 Then point="+"&point
		If expr>=0 Then expr="+"&expr
		hu.conn("update 74hu_user set [money]=[money]"&money&",[points]=[points]"&point&",[experience]=[experience]"&expr&" where id="&userid)
	End If
End Sub

'会员消费金币,积分,经验,和 setUserAmount() 区别在于金币,积分,经验为负数时无法消费
Sub setUserAmountBySelf(userid, rules)
	Dim ruleArray,money,point,expr,rs
	ruleArray = Split(rules&"",",")
	If UBound(ruleArray)<2 Then rupt "错误","积分规则配置出错"
	money = ruleArray(0)
	point = ruleArray(1)
	expr = ruleArray(2)
	If hu_isNumber(money) And hu_isNumber(point) And hu_isNumber(expr) And userid>0 Then
		If money<0 Or point<0 Or expr<0 Then
			Set rs = hu.conn("select top 1 id from 74hu_user where id="&userid&" and money>="&-money&" and points>="&-point&" and experience>="&-expr&"")
			If rs.eof Then rupt "错误",""&bbsMoney&"、"&bbsPoint&"或经验不足"
			Set rs = Nothing
		End If
		If money>=0 Then money="+"&money
		If point>=0 Then point="+"&point
		If expr>=0 Then expr="+"&expr
		hu.conn("update 74hu_user set [money]=[money]"&money&",[points]=[points]"&point&",[experience]=[experience]"&expr&" where id="&userid)
	End If
End Sub

'记录访客动态
Sub setVisitPage(link)
	Dim userIp:userIp=user_array(7)
	hu.conn("update 74hu_iprr set [link]='"&Replace(link,"'","''")&"', [time]='"&time_now&"' where hu_userip='"&userIp&"'")
End Sub

'修改访客信息
Sub setVisitUser(userid)
	Dim userIp:userIp=user_array(7)
	hu.conn("update 74hu_iprr set [userid]="&userid&" where hu_userip='"&userIp&"'")
End Sub

Sub delVisit(userid)
	hu.conn("delete from 74hu_iprr where userid="&userid&"")
End Sub

'获取访客动态
Function getVisit(num)
	Dim rs,link,userid_,usertime,body_
	If Not ifNum(num) Then num=1
	If num<1 Then num=1
	num=int(num)
	body_=""
	Set rs=hu.conn("select top "&num&" link,userid,time from 74hu_iprr order by [time] desc")
	If Not rs.eof Then
		While Not rs.eof
			link=rs("link")
			userid_ = rs("userid")
			time__ = DateDiff("s", rs("time"), time_now)
			If userid_=0 Then
				user_ ="游客"
			Else
				user_ = hu.url("bbs_user.asp?id="&userid_,getUserName(userid_))
			End If
			If link<>"" Then
				link = Replace(link , "[sid]", sid_str)
			Else
				link = "其他页面.."
			End If
			body_ = body_ & forTimeDiff(time__)&"前，"&user_&"正在看"&link&"<br/>"
			rs.movenext
		Wend
	End If
	getVisit=body_
	Set rs=Nothing
End Function

'检查是否设置了密保
Function ifSetSecret(userid)
	Dim rs,rt
	rt = False
	Set rs=hu.conn("select top 1 id from 74hu_password where userid="&userid)
	If Not rs.eof Then
		rt = True
	End If
	Set rs=Nothing
	ifSetSecret=rt
End Function
%>